home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Graphics Programming (2nd Edition) / Visual Basic Graphics Programming 2nd Edition.iso / Src / Ch10 / Sierp.frm (.txt) < prev    next >
Visual Basic Form  |  1999-06-08  |  5KB  |  166 lines
  1. VERSION 5.00
  2. Begin VB.Form frmSierp 
  3.    Caption         =   "Sierp"
  4.    ClientHeight    =   4335
  5.    ClientLeft      =   2280
  6.    ClientTop       =   900
  7.    ClientWidth     =   5310
  8.    LinkTopic       =   "Form1"
  9.    PaletteMode     =   1  'UseZOrder
  10.    ScaleHeight     =   4335
  11.    ScaleWidth      =   5310
  12.    Begin VB.TextBox txtDepth 
  13.       Height          =   285
  14.       Left            =   480
  15.       MaxLength       =   3
  16.       TabIndex        =   0
  17.       Text            =   "3"
  18.       Top             =   0
  19.       Width           =   375
  20.    End
  21.    Begin VB.PictureBox picCanvas 
  22.       AutoRedraw      =   -1  'True
  23.       Height          =   4335
  24.       Left            =   960
  25.       ScaleHeight     =   285
  26.       ScaleMode       =   3  'Pixel
  27.       ScaleWidth      =   285
  28.       TabIndex        =   3
  29.       Top             =   0
  30.       Width           =   4335
  31.    End
  32.    Begin VB.CommandButton cmdGo 
  33.       Caption         =   "Go"
  34.       Default         =   -1  'True
  35.       Height          =   375
  36.       Left            =   120
  37.       TabIndex        =   1
  38.       Top             =   480
  39.       Width           =   615
  40.    End
  41.    Begin VB.Label Label1 
  42.       Caption         =   "Depth"
  43.       Height          =   255
  44.       Index           =   0
  45.       Left            =   0
  46.       TabIndex        =   2
  47.       Top             =   0
  48.       Width           =   495
  49.    End
  50. Attribute VB_Name = "frmSierp"
  51. Attribute VB_GlobalNameSpace = False
  52. Attribute VB_Creatable = False
  53. Attribute VB_PredeclaredId = True
  54. Attribute VB_Exposed = False
  55. Option Explicit
  56. ' Draw a type A sierpinski sub-curve.
  57. Private Sub SierpA(ByVal depth As Integer, ByVal dist As Single)
  58.     If depth = 1 Then
  59.         picCanvas.Line -Step(-dist, dist)
  60.         picCanvas.Line -Step(-dist, 0)
  61.         picCanvas.Line -Step(-dist, -dist)
  62.     Else
  63.         SierpA depth - 1, dist
  64.         picCanvas.Line -Step(-dist, dist)
  65.         SierpB depth - 1, dist
  66.         picCanvas.Line -Step(-dist, 0)
  67.         SierpD depth - 1, dist
  68.         picCanvas.Line -Step(-dist, -dist)
  69.         SierpA depth - 1, dist
  70.     End If
  71. End Sub
  72. ' Draw a type B sierpinski sub-curve.
  73. Private Sub SierpB(ByVal depth As Integer, ByVal dist As Single)
  74.     If depth = 1 Then
  75.         picCanvas.Line -Step(dist, dist)
  76.         picCanvas.Line -Step(0, dist)
  77.         picCanvas.Line -Step(-dist, dist)
  78.     Else
  79.         SierpB depth - 1, dist
  80.         picCanvas.Line -Step(dist, dist)
  81.         SierpC depth - 1, dist
  82.         picCanvas.Line -Step(0, dist)
  83.         SierpA depth - 1, dist
  84.         picCanvas.Line -Step(-dist, dist)
  85.         SierpB depth - 1, dist
  86.     End If
  87. End Sub
  88. ' Draw a type C sierpinski sub-curve.
  89. Private Sub SierpC(ByVal depth As Integer, ByVal dist As Single)
  90.     If depth = 1 Then
  91.         picCanvas.Line -Step(dist, -dist)
  92.         picCanvas.Line -Step(dist, 0)
  93.         picCanvas.Line -Step(dist, dist)
  94.     Else
  95.         SierpC depth - 1, dist
  96.         picCanvas.Line -Step(dist, -dist)
  97.         SierpD depth - 1, dist
  98.         picCanvas.Line -Step(dist, 0)
  99.         SierpB depth - 1, dist
  100.         picCanvas.Line -Step(dist, dist)
  101.         SierpC depth - 1, dist
  102.     End If
  103. End Sub
  104. ' Draw a type D sierpinski sub-curve.
  105. Private Sub SierpD(ByVal depth As Integer, ByVal dist As Single)
  106.     If depth = 1 Then
  107.         picCanvas.Line -Step(-dist, -dist)
  108.         picCanvas.Line -Step(0, -dist)
  109.         picCanvas.Line -Step(dist, -dist)
  110.     Else
  111.         SierpD depth - 1, dist
  112.         picCanvas.Line -Step(-dist, -dist)
  113.         SierpA depth - 1, dist
  114.         picCanvas.Line -Step(0, -dist)
  115.         SierpC depth - 1, dist
  116.         picCanvas.Line -Step(dist, -dist)
  117.         SierpD depth - 1, dist
  118.     End If
  119. End Sub
  120. ' Draw the complete Sierpinski curve.
  121. Private Sub Sierpinski(depth As Integer, dist As Single)
  122.     SierpB depth, dist
  123.     picCanvas.Line -Step(dist, dist)
  124.     SierpC depth, dist
  125.     picCanvas.Line -Step(dist, -dist)
  126.     SierpD depth, dist
  127.     picCanvas.Line -Step(-dist, -dist)
  128.     SierpA depth, dist
  129.     picCanvas.Line -Step(-dist, dist)
  130. End Sub
  131. Private Sub CmdGo_Click()
  132. Dim depth As Integer
  133. Dim total_length As Single
  134. Dim start_x As Single
  135. Dim start_y As Single
  136. Dim start_length As Single
  137.     picCanvas.Cls
  138.     MousePointer = vbHourglass
  139.     DoEvents
  140.     ' Get the parameters.
  141.     If Not IsNumeric(txtDepth.Text) Then txtDepth.Text = "5"
  142.     depth = CInt(txtDepth.Text)
  143.     ' See how big we can make the curve.
  144.     If picCanvas.ScaleHeight < picCanvas.ScaleWidth Then
  145.         total_length = 0.9 * picCanvas.ScaleHeight
  146.     Else
  147.         total_length = 0.9 * picCanvas.ScaleWidth
  148.     End If
  149.     ' Compute the side length for this depth.
  150.     start_length = total_length / (3 * 2 ^ depth - 1)
  151.     start_x = (picCanvas.ScaleWidth - total_length) / 2
  152.     start_y = (picCanvas.ScaleHeight - total_length) / 2 + start_length
  153.     ' Draw the curve.
  154.     picCanvas.CurrentX = start_x
  155.     picCanvas.CurrentY = start_y
  156.     Sierpinski depth, start_length
  157.     MousePointer = vbDefault
  158. End Sub
  159. Private Sub Form_Resize()
  160. Dim wid As Single
  161.     wid = ScaleWidth - picCanvas.Left
  162.     If wid < 120 Then wid = 120
  163.     picCanvas.Move picCanvas.Left, 0, _
  164.         wid, ScaleHeight
  165. End Sub
  166.